home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 1159.ZIP / ISR.PRG < prev    next >
Text File  |  1987-03-17  |  15KB  |  731 lines

  1. *              This program is a work of the Tennessee Valley
  2. *              Authority (TVA), U.S. Government, and is in
  3. *              the public domain.
  4. *
  5. * TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING, 
  6. * BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF 
  7. * MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or 
  8. * completeness of processes, procedures, designs, definitions, instructions, 
  9. * information, or functioning of the program(s) and related material; TVA 
  10. * further expressly disclaims any knowledge or purpose for which the program(s) 
  11. * may be utilized or its applicability for such use, nor shall the fact of 
  12. * making it available constitute any such representation, warranty, or 
  13. * knowledge, nor does TVA assume any liability, responsibility, or obligation 
  14. * arising from the use or malfunctioning of the computer program(s) or related 
  15. * materials.
  16. *
  17. CLEAR
  18. SET HELP OFF
  19. SET TALK OFF
  20. SET ESCAPE OFF
  21. SET SAFETY OFF
  22. SET BELL OFF
  23. SET SCOREBOARD OFF
  24. CLOSE DATABASES
  25. USE REPWORK
  26. ZAP
  27. USE REPERR
  28. ZAP
  29. USE REPDUP
  30. INDEX ON TVA_NO TO REPDNX
  31. SET INDEX TO REPDNX
  32. ZAP
  33. USE REPDEL
  34. ZAP
  35. USE
  36. PUBLIC DBNAME,INDEX1,INDEX2,DTCHECK,OSS,INSTNAME,TVANUMBER,SERIALNUM,CALIBDATE
  37. PUBLIC DUEDATE,CALINTERVL,LOCATNAME,REMARKNM,CATEGORY1,CATEGORY2,CATEGORY3
  38. PUBLIC SUBCAT1,SUBCAT2,SUBCAT3,SUB1ABB,SUB2ABB,SUB3ABB,CAT3ABB,TITLE1,CALOVER
  39. PUBLIC SPACING,PAPEROUT,CMDATE,DUPREC,TVAID,SERID,MULTTV,MULTSN,NP,GLPRINT
  40. DATABASE21='O'
  41. RESTORE FROM DATANAME ADDITIVE
  42. IF FILE ("PUB_DOM.AIN")
  43. ?'             This program is a work of the Tennessee Valley'
  44. ?'             Authority (TVA), U.S. Government, and is in'
  45. ?'             the public domain.'
  46. ?
  47. ?'TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING,'
  48. ?'BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF'
  49. ?'MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or'
  50. ?'completeness of processes, procedures, designs, definitions, instructions,'
  51. ?'information, or functioning of the program(s) and related material; TVA'
  52. ?'further expressly disclaims any knowledge or purpose for which the program(s)'
  53. ?'may be utilized or its applicability for such use, nor shall the fact of'
  54. ?'making it available constitute any such representation, warranty, or'
  55. ?'knowledge, nor does TVA assume any liability, responsibility, or obligation'
  56. ?'arising from the use or malfunctioning of the computer program(s) or'
  57. ?'related materials.'
  58. ?
  59. ?
  60. ?
  61. ?
  62. ?
  63. WAIT '                 Press any key to continue.' TO AAAAAA
  64. ENDIF
  65. IF DATABASE21='1'
  66.   SET COLOR TO W/B,W/R,BG
  67. ENDIF
  68. DREMARK='DATE OVERRIDE IS ON.'
  69. TDREMARK='TEMPORARY DATE OVERRIDE.'
  70. ADDFILE=0
  71. MODFILE=0
  72. GLCALDU=0
  73. MULTTV=0
  74. MULTSN=0
  75. CALOVER=0
  76. N4='K'
  77. DO WHILE N4#'Y' .AND. N4#'N'
  78.  CLEAR
  79.  @ 0,37 SAY 'ISR-20'
  80.  @ 2,33 SAY '(Version 3.03)'
  81.  @ 4,30 SAY 'by Marty L. Jamieson'
  82.  @ 7,34 SAY 'IS THE YEAR'
  83.  @ 9,36 SAY YEAR(DATE())
  84.  @ 11,38 SAY 'AND'
  85.  @ 13,31 SAY 'THE MONTH AND DAY'
  86.  @ 15,40-INT((LEN(CMONTH(DATE()))+3)/2+.5) SAY CMONTH(DATE())
  87.  ??' '
  88.  ?? DAY(DATE())
  89.  @ 17,38 SAY 'AND'
  90.  @ 19,31 SAY 'THE NAME OF TODAY'
  91.  @ 21,40-INT(LEN(CDOW(DATE()))/2+.5) SAY CDOW(DATE())
  92.  @ 24,12 SAY 'CORRECT DATE IS CRITICAL FOR PROPER FUNCTIONING OF ISR-20'
  93.  @ 22,0 SAY ' '
  94.  WAIT '                                     (Y/N)' TO N4
  95.  N4=UPPER(N4)
  96. IF N4='N'
  97.  CLEAR
  98.  @ 0,7 SAY "Please enter today's date."
  99.  ?
  100.  RUN DATE
  101.  N4='K'
  102. ENDIF
  103. ENDDO
  104. DO WHILE N4#'STOP'
  105. DO WHILE ASC(N4)<65 .OR. ASC(N4)>86
  106. CLEAR
  107. @ 0,19 SAY 'What would you like to do ?'
  108. @ 2,19 SAY 'A)  Go to the '
  109. ?? DATABASE1
  110. ??' data base.'
  111. @ 3,19 SAY 'B)  Go to the '
  112. ?? DATABASE2
  113. ??' data base.'
  114. @ 4,19 SAY 'C)  Go to the '
  115. ?? DATABASE3
  116. ??' data base.'
  117. @ 5,19 SAY 'D)  Go to the '
  118. ?? DATABASE4
  119. ??' data base.'
  120. @ 6,19 SAY 'E)  Go to the '
  121. ?? DATABASE5
  122. ??' data base.'
  123. @ 7,19 SAY 'F)  Go to the '
  124. ?? DATABASE6
  125. ??' data base.'
  126. @ 8,19 SAY 'G)  Go to the '
  127. ?? DATABASE7
  128. ??' data base.'
  129. @ 9,19 SAY 'H)  Go to the '
  130. ?? DATABASE8
  131. ??' data base.'
  132. @ 10,19 SAY 'I)  Go to the '
  133. ?? DATABASE9
  134. ??' data base.'
  135. @ 11,19 SAY 'J)  Go to the '
  136. ?? DATABASE10
  137. ??' data base.'
  138. @ 12,19 SAY 'K)  Go to the '
  139. ?? DATABASE11
  140. ??' data base.'
  141. @ 13,19 SAY 'L)  Go to the '
  142. ?? DATABASE12
  143. ??' data base.'
  144. @ 14,19 SAY 'M)  Go to the '
  145. ?? DATABASE13
  146. ??' data base.'
  147. @ 15,19 SAY 'N)  Go to the '
  148. ?? DATABASE14
  149. ??' data base.'
  150. @ 16,19 SAY 'O)  Go to the '
  151. ?? DATABASE15
  152. ??' data base.'
  153. @ 17,19 SAY 'P)  Go to the '
  154. ?? DATABASE16
  155. ??' data base.'
  156. @ 18,19 SAY 'Q)  Go to the '
  157. ?? DATABASE17
  158. ??' data base.'
  159. @ 19,19 SAY 'R)  Go to the '
  160. ?? DATABASE18
  161. ??' data base.'
  162. @ 20,19 SAY 'S)  Go to the '
  163. ?? DATABASE19
  164. ??' data base.'
  165. @ 21,19 SAY 'T)  Go to the '
  166. ?? DATABASE20
  167. ??' data base.'
  168. @ 22,19 SAY 'U)  Other options.'
  169. WAIT '                   V)  QUIT   ' TO N4
  170. ??'    WORKING . . .'
  171. N4=UPPER(N4)
  172. ENDDO
  173. GLPRINT=0
  174. N6='Z'
  175. DO CASE
  176.  CASE N4='V'
  177.   CLEAR ALL
  178.   RUN CD\
  179.   SET COLOR TO
  180.   QUIT
  181.  CASE N4='A'
  182.   NCHR='1'
  183.   DO DBSELECT
  184.   DO OSSCOM
  185.  CASE N4='B'
  186.   NCHR='2'
  187.   DO DBSELECT
  188.   DO OSSCOM
  189.  CASE N4='C'
  190.   NCHR='3'
  191.   DO DBSELECT
  192.   DO OSSCOM
  193.  CASE N4='D'
  194.   NCHR='4'
  195.   DO DBSELECT
  196.   DO OSSCOM
  197.  CASE N4='E'
  198.   NCHR='5'
  199.   DO DBSELECT
  200.   DO OSSCOM
  201.  CASE N4='F'
  202.   NCHR='6'
  203.   DO DBSELECT
  204.   DO OSSCOM
  205.  CASE N4='G'
  206.   NCHR='7'
  207.   DO DBSELECT
  208.   DO OSSCOM
  209.  CASE N4='H'
  210.   NCHR='8'
  211.   DO DBSELECT
  212.   DO OSSCOM
  213.  CASE N4='I'
  214.   NCHR='9'
  215.   DO DBSELECT
  216.   DO OSSCOM
  217.  CASE N4='J'
  218.   NCHR='10'
  219.   DO DBSELECT
  220.   DO OSSCOM
  221.  CASE N4='K'
  222.   NCHR='11'
  223.   DO DBSELECT
  224.   DO OSSCOM
  225.  CASE N4='L'
  226.   NCHR='12'
  227.   DO DBSELECT
  228.   DO OSSCOM
  229.  CASE N4='M'
  230.   NCHR='13'
  231.   DO DBSELECT
  232.   DO OSSCOM
  233.  CASE N4='N'
  234.   NCHR='14'
  235.   DO DBSELECT
  236.   DO OSSCOM
  237.  CASE N4='O'
  238.   NCHR='15'
  239.   DO DBSELECT
  240.   DO OSSCOM
  241.  CASE N4='P'
  242.   NCHR='16'
  243.   DO DBSELECT
  244.   DO OSSCOM
  245.  CASE N4='Q'
  246.   NCHR='17'
  247.   DO DBSELECT
  248.   DO OSSCOM
  249.  CASE N4='R'
  250.   NCHR='18'
  251.   DO DBSELECT
  252.   DO OSSCOM
  253.  CASE N4='S'
  254.   NCHR='19'
  255.   DO DBSELECT
  256.   DO OSSCOM
  257.  CASE N4='T'
  258.   NCHR='20'
  259.   DO DBSELECT
  260.   DO OSSCOM
  261.  CASE N4='U'
  262.   N4='Z'
  263.   N6=N4
  264.  DO WHILE ASC(N6)<65.OR.ASC(N6)>68
  265.   CLEAR
  266.   @ 1,14 SAY 'What do you want to do ?'
  267.   @ 4,10 SAY 'A)  Set data base options and conditions.'
  268.   @ 6,10 SAY 'B)  Rebuild data base(s) to the most efficient structure.'
  269.   @ 8,10 SAY 'C)  Rebuild data base(s) which you believe may possibly be ;
  270. damaged.'
  271.   @ 9,14 SAY '(The index files associated with the data base(s) will be rebuilt'
  272.   @ 10,14 SAY 'from scratch.)'
  273.   @ 12,10 SAY 'D)  Do a Global Search on the "NEXT DATE" field (fifth column) '
  274.   ?? 'in '
  275.   @ 13,14 SAY 'ALL data bases from date to date, and print out the qualifying'
  276.   @ 14,14 SAY 'records.  (The search will include all categories and'
  277.   @ 15,14 SAY 'subcategories.  Where the date has been overridden, the'
  278.   @ 16,14 SAY 'date listed in the "NEXT DATE" field will be considered to'
  279.   @ 17,14 SAY 'be correct.)'
  280.   @ 19,10 SAY 'E)  Change from monochromatic to color or vice-versa.'
  281.   @ 22,14 SAY 'Press RETURN to return to the previous menu.'
  282.   WAIT '                            ' TO N6
  283.   ??'  WORKING . . .'
  284.   N6=UPPER(N6)
  285.   DO CASE
  286.    CASE ASC(N6)=0
  287.     EXIT
  288.    CASE N6='A'
  289.     DO OPTSET.PRG
  290.    CASE N6='D'
  291. MULTTV=0
  292. MULTSN=0
  293.   COMPDATE1=CTOD('12/12/86')
  294.   COMPDATE2=CTOD('12/12/84')
  295.  DO WHILE COMPDATE1>COMPDATE2
  296.   N6=N4
  297.   DO WHILE N6#'Y'
  298.   @ 14,0 CLEAR
  299.   ?'What beginning date do you choose ?'
  300.   ?
  301.   ACCEPT 'Date format:  ##/##/####      DATE:  ' TO CHOSDATE
  302.   CHOSDATE=LTRIM(TRIM(CHOSDATE))
  303.   IF ASC(CHOSDATE)=0
  304.    EXIT
  305.   ENDIF
  306.   COMPDATE1=CTOD(CHOSDATE)
  307.  IF LEN(CHOSDATE)<9
  308.   IF YEAR(COMPDATE1)+100-YEAR(DATE())<10
  309.    MOCALDT=MONTH(COMPDATE1)
  310.    DYCALDT=DAY(COMPDATE1)
  311.    YRCALDT=INT(YEAR(COMPDATE1)+100+.5)
  312.    IF MOCALDT<10
  313.      M=1
  314.     ELSE
  315.      M=2
  316.    ENDIF
  317.    IF DYCALDT<10
  318.      D=1
  319.     ELSE
  320.      D=2
  321.    ENDIF
  322.    COMPDATE1=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0)) 
  323.   ENDIF
  324.  ENDIF
  325.   ??'Is '
  326.   ?? CDOW(COMPDATE1)
  327.   ??', '
  328.   ?? CMONTH(COMPDATE1)
  329.   ?? DAY(COMPDATE1)
  330.   ??', '
  331.   ?? YEAR(COMPDATE1)
  332.   ??' the date which you want ?  (Y/N)'
  333.   WAIT '                                                           ' TO N6
  334.   N6=UPPER(N6)
  335.   IF ASC(N6)=0
  336.    EXIT
  337.   ENDIF
  338.   ENDDO
  339.   ?
  340.   ?
  341.   N6=N4
  342.   DO WHILE N6#'Y'
  343.   @ 14,0 CLEAR
  344.   ?'What ending date do you choose ?'
  345.   ?
  346.   ACCEPT 'Date format:  ##/##/####      DATE:  ' TO CHOSDATE
  347.   CHOSDATE=LTRIM(TRIM(CHOSDATE))
  348.   IF ASC(CHOSDATE)=0
  349.    EXIT
  350.   ENDIF
  351.   COMPDATE2=CTOD(CHOSDATE)
  352.  IF LEN(CHOSDATE)<9
  353.   IF YEAR(COMPDATE2)+100-YEAR(DATE())<10
  354.    MOCALDT=MONTH(COMPDATE2)
  355.    DYCALDT=DAY(COMPDATE2)
  356.    YRCALDT=INT(YEAR(COMPDATE2)+100+.5)
  357.    IF MOCALDT<10
  358.      M=1
  359.     ELSE
  360.      M=2
  361.    ENDIF
  362.    IF DYCALDT<10
  363.      D=1
  364.     ELSE
  365.      D=2
  366.    ENDIF
  367.    COMPDATE2=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0)) 
  368.   ENDIF
  369.  ENDIF
  370.   ??'Is '
  371.   ?? CDOW(COMPDATE2)
  372.   ??', '
  373.   ?? CMONTH(COMPDATE2)
  374.   ?? DAY(COMPDATE2)
  375.   ??', '
  376.   ?? YEAR(COMPDATE2)
  377.   ??' the date which you want ?  (Y/N)'
  378.   WAIT '                                                           ' TO N6
  379.   N6=UPPER(N6)
  380.   IF ASC(N6)=0
  381.    EXIT
  382.   ENDIF
  383.   ENDDO
  384.   ?
  385.   ?
  386.   IF COMPDATE1>COMPDATE2
  387.    @ 14,0 CLEAR
  388.    ?'                         INVALID DATE ENTRY'
  389.    ?
  390.    ?
  391.    WAIT '                    Press any key to continue . . .' TO N1
  392.   ENDIF
  393.  ENDDO
  394.     GLCALDU=1
  395.     PRINTOUT=1
  396.     ADDFILE=0
  397.     MODFILE=0
  398.     VIEW=0
  399.  READY='K'
  400.  DO WHILE READY#'Y'
  401.   CLEAR
  402.   GOBACK=0
  403.   ?
  404.   ?'Depending upon the date selections you have made, very small to very large'
  405.   ?
  406.   ?'amounts of data may be printed, up to the capacity of your computer'
  407.   ?
  408.   ?'system.  You may escape this routine by pressing the "RETURN" key at this'
  409.   ?
  410.  ?'time.  Make SURE the printer is ready to print.  Then press "Y" to continue,'
  411.   ?
  412.   ?'or else press "RETURN" to return to the MAIN menu.'
  413.   ?
  414.   ?
  415.   ?'PLEASE NOTE:  If you should ever make a mistake and there is a system error'
  416.   ?
  417.   ?'because the printer is not ready, FIRST enable the printer and THEN press'
  418.   ?
  419.   ?'"I" for the "ignor" option until no further error is indicated.'
  420.   ?
  421.   WAIT '                                    ' TO READY
  422.   READY=UPPER(READY)
  423.   IF ASC(READY)=0
  424.    GOBACK=1
  425.    EXIT
  426.   ENDIF
  427.  ENDDO
  428.     IF GOBACK=1
  429.      EXIT
  430.     ENDIF
  431.     CNN=1
  432.     PRNTED=0
  433.     GLPRINT=1
  434.     CLEAR
  435.     DO WHILE CNN<21
  436.      NCHR=LTRIM(STR(CNN))
  437.      DO DBSELECT
  438.      SELECT 1
  439.      @ 8,15 SAY 'PLEASE DO NOT PRESS ANY KEYS DURING THIS PROCEDURE.'
  440.      @ 14,20 SAY 'Data base in use:'
  441.      @ 14,38 CLEAR
  442.      @ 14,38 SAY OSS
  443.      SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT
  444.      GO TOP
  445.      IF .NOT. EOF()
  446.       PRNTED=1
  447.       DO REPINSTP
  448.      ENDIF
  449.      CNN=CNN+1
  450.     ENDDO
  451.     IF PRNTED=1
  452.      EJECT
  453.      EJECT
  454.     ENDIF
  455.     GLCALDU=0
  456.     N7='Z'
  457.    CASE N6='B'.OR.N6='C'
  458.    N7='Z'
  459.   DO WHILE ASC(N7)<65.OR.ASC(N7)>84
  460. CLEAR
  461. IF N6='C'
  462. @ 0,19 SAY '(For possibly damaged files.)'
  463. ENDIF
  464. @ 1,19 SAY 'What would you like to do ?'
  465. @ 3,19 SAY 'A)  Rebuild the '
  466. ?? DATABASE1
  467. ??' data base.'
  468. @ 4,19 SAY 'B)  Rebuild the '
  469. ?? DATABASE2
  470. ??' data base.'
  471. @ 5,19 SAY 'C)  Rebuild the '
  472. ?? DATABASE3
  473. ??' data base.'
  474. @ 6,19 SAY 'D)  Rebuild the '
  475. ?? DATABASE4
  476. ??' data base.'
  477. @ 7,19 SAY 'E)  Rebuild the '
  478. ?? DATABASE5
  479. ??' data base.'
  480. @ 8,19 SAY 'F)  Rebuild the '
  481. ?? DATABASE6
  482. ??' data base.'
  483. @ 9,19 SAY 'G)  Rebuild the '
  484. ?? DATABASE7
  485. ??' data base.'
  486. @ 10,19 SAY 'H)  Rebuild the '
  487. ?? DATABASE8
  488. ??' data base.'
  489. @ 11,19 SAY 'I)  Rebuild the '
  490. ?? DATABASE9
  491. ??' data base.'
  492. @ 12,19 SAY 'J)  Rebuild the '
  493. ?? DATABASE10
  494. ??' data base.'
  495. @ 13,19 SAY 'K)  Rebuild the '
  496. ?? DATABASE11
  497. ??' data base.'
  498. @ 14,19 SAY 'L)  Rebuild the '
  499. ?? DATABASE12
  500. ??' data base.'
  501. @ 15,19 SAY 'M)  Rebuild the '
  502. ?? DATABASE13
  503. ??' data base.'
  504. @ 16,19 SAY 'N)  Rebuild the '
  505. ?? DATABASE14
  506. ??' data base.'
  507. @ 17,19 SAY 'O)  Rebuild the '
  508. ?? DATABASE15
  509. ??' data base.'
  510. @ 18,19 SAY 'P)  Rebuild the '
  511. ?? DATABASE16
  512. ??' data base.'
  513. @ 19,19 SAY 'Q)  Rebuild the '
  514. ?? DATABASE17
  515. ??' data base.'
  516. @ 20,19 SAY 'R)  Rebuild the '
  517. ?? DATABASE18
  518. ??' data base.'
  519. @ 21,19 SAY 'S)  Rebuild the '
  520. ?? DATABASE19
  521. ??' data base.'
  522. @ 22,19 SAY 'T)  Rebuild the '
  523. ?? DATABASE20
  524. ??' data base.'
  525. WAIT '    Press "RETURN" to escape this routine and go to the previous;
  526.  menu.' TO N7
  527. ??' WORKING'
  528. N7=UPPER(N7)
  529. IF ASC(N7)=0
  530.  EXIT
  531. ENDIF
  532. DO CASE
  533.  CASE N7='A'
  534.   NCHR='1'
  535.   IF N6='A'
  536.    DBINDEX=0
  537.    DO DBPACK
  538.   ELSE
  539.    DBINDEX=1
  540.    DO DBPACK
  541.   ENDIF
  542.  CASE N7='B'
  543.   NCHR='2'
  544.   IF N6='A'
  545.    DBINDEX=0
  546.    DO DBPACK
  547.   ELSE
  548.    DBINDEX=1
  549.    DO DBPACK
  550.   ENDIF
  551.  CASE N7='C'
  552.   NCHR='3'
  553.   IF N6='A'
  554.    DBINDEX=0
  555.    DO DBPACK
  556.   ELSE
  557.    DBINDEX=1
  558.    DO DBPACK
  559.   ENDIF
  560.  CASE N7='D'
  561.   NCHR='4'
  562.   IF N6='A'
  563.    DBINDEX=0
  564.    DO DBPACK
  565.   ELSE
  566.    DBINDEX=1
  567.    DO DBPACK
  568.   ENDIF
  569.  CASE N7='E'
  570.   NCHR='5'
  571.   IF N6='A'
  572.    DBINDEX=0
  573.    DO DBPACK
  574.   ELSE
  575.    DBINDEX=1
  576.    DO DBPACK
  577.   ENDIF
  578.  CASE N7='F'
  579.   NCHR='6'
  580.   IF N6='A'
  581.    DBINDEX=0
  582.    DO DBPACK
  583.   ELSE
  584.    DBINDEX=1
  585.    DO DBPACK
  586.   ENDIF
  587.  CASE N7='G'
  588.   NCHR='7'
  589.   IF N6='A'
  590.    DBINDEX=0
  591.    DO DBPACK
  592.   ELSE
  593.    DBINDEX=1
  594.    DO DBPACK
  595.   ENDIF
  596.  CASE N7='H'
  597.   NCHR='8'
  598.   IF N6='A'
  599.    DBINDEX=0
  600.    DO DBPACK
  601.   ELSE
  602.    DBINDEX=1
  603.    DO DBPACK
  604.   ENDIF
  605.  CASE N7='I'
  606.   NCHR='9'
  607.   IF N6='A'
  608.    DBINDEX=0
  609.    DO DBPACK
  610.   ELSE
  611.    DBINDEX=1
  612.    DO DBPACK
  613.   ENDIF
  614.  CASE N7='J'
  615.   NCHR='10'
  616.   IF N6='A'
  617.    DBINDEX=0
  618.    DO DBPACK
  619.   ELSE
  620.    DBINDEX=1
  621.    DO DBPACK
  622.   ENDIF
  623.  CASE N7='K'
  624.   NCHR='11'
  625.   IF N6='A'
  626.    DBINDEX=0
  627.    DO DBPACK
  628.   ELSE
  629.    DBINDEX=1
  630.    DO DBPACK
  631.   ENDIF
  632.  CASE N7='L'
  633.   NCHR='12'
  634.   IF N6='A'
  635.    DBINDEX=0
  636.    DO DBPACK
  637.   ELSE
  638.    DBINDEX=1
  639.    DO DBPACK
  640.   ENDIF
  641.  CASE N7='M'
  642.   NCHR='13'
  643.   IF N6='A'
  644.    DBINDEX=0
  645.    DO DBPACK
  646.   ELSE
  647.    DBINDEX=1
  648.    DO DBPACK
  649.   ENDIF
  650.  CASE N7='N'
  651.   NCHR='14'
  652.   IF N6='A'
  653.    DBINDEX=0
  654.    DO DBPACK
  655.   ELSE
  656.    DBINDEX=1
  657.    DO DBPACK
  658.   ENDIF
  659.  CASE N7='O'
  660.   NCHR='15'
  661.   IF N6='A'
  662.    DBINDEX=0
  663.    DO DBPACK
  664.   ELSE
  665.    DBINDEX=1
  666.    DO DBPACK
  667.   ENDIF
  668.  CASE N7='P'
  669.   NCHR='16'
  670.   IF N6='A'
  671.    DBINDEX=0
  672.    DO DBPACK
  673.   ELSE
  674.    DBINDEX=1
  675.    DO DBPACK
  676.   ENDIF
  677.  CASE N7='Q'
  678.   NCHR='17'
  679.   IF N6='A'
  680.    DBINDEX=0
  681.    DO DBPACK
  682.   ELSE
  683.    DBINDEX=1
  684.    DO DBPACK
  685.   ENDIF
  686.  CASE N7='R'
  687.   NCHR='18'
  688.   IF N6='A'
  689.    DBINDEX=0
  690.    DO DBPACK
  691.   ELSE
  692.    DBINDEX=1
  693.    DO DBPACK
  694.   ENDIF
  695.  CASE N7='S'
  696.   NCHR='19'
  697.   IF N6='A'
  698.    DBINDEX=0
  699.    DO DBPACK
  700.   ELSE
  701.    DBINDEX=1
  702.    DO DBPACK
  703.   ENDIF
  704.  CASE N7='T'
  705.   NCHR='20'
  706.   IF N6='A'
  707.    DBINDEX=0
  708.    DO DBPACK
  709.   ELSE
  710.    DBINDEX=1
  711.    DO DBPACK
  712.   ENDIF
  713.  ENDCASE
  714.  N7='Z'
  715.  ENDDO
  716.  CASE N6='E'
  717.   IF DATABASE21='1'
  718.    SET COLOR TO
  719.    DATABASE21='O'
  720.    ELSE
  721.     DATABASE21='1'
  722.     SET COLOR TO W/B,W/R,BG
  723.   ENDIF
  724.   SAVE ALL LIKE DATABASE* TO DATANAME
  725. ENDCASE
  726.  N6='Z'
  727. ENDDO
  728. ENDCASE
  729. ENDDO
  730. RETURN
  731.